; Fonctions pratiques

; Fonction construisant un envirronement local a une fonction
(defun make-stat-env (args pos)
 (if (null args)
     ()
   (if (atom args)
     ; On fait une liste simple
     (cons args pos)
   ; On construit la liste petit a petit
   (cons (make-stat-env (car args) pos) (make-stat-env (cdr args) (+ 1 pos))))))


; COMPILATEUR

(defun map-lisp2li (expr env)
  (if (atom expr)
      expr
    (cons (lisp2li (car expr) env) (map-lisp2li (cdr expr) env))))

(defun lisp2li (expr env)
; Si c'est un atome
  (if (atom expr)
    ; Si c'est un literal
    (if (constantp expr) 
        `(:lit . ,expr)
      ; Si c'est une variable connue
      (let ((cell (assoc expr env)))
         (if cell `(:var . ,(cdr cell))
           (warn "~s n'est pas une variable" expr))))

 ; Sinon c'est une liste
        ; Si le car n'est pas un symbole
  (cond ((not (symbolp (car expr)))
          (warn "NYI : ~s" (car expr)))
        ; Cas mcall
        ((not (null (get-defun (car expr))))
         `(:mcall ,(car expr) . ,(map-lisp2li (cdr expr) env)))
        ; Si le symbole n'est pas connu
        ((not (fboundp (car expr)))
         `(:unknown ,expr . ,env))
        ; Si c'est un symbole connu
        ((special-form-p (car expr))
         (case (car expr)
           ; quote
           (quote `(:lit . ,(cadr expr)))
           ; if
           (if `(:if . ,(map-lisp2li (cdr expr) env)))
           ;Progn
           (progn `(:progn . ,(map-lisp2li (cdr expr) env)))
	   ;Cond
	   (cond (lisp2li (macroexpand-1 expr) env))
	   ;Case
	   (case (lisp2li (macroexpand-1 expr) env))
	   ;Let
	   (let `(:let ,(+ 1 (length (cdr expr))) . ,(map-lisp2li (cadr expr) env)))
           ; Defaut du case
           (t (warn "NYI : ~s" (car expr) ))))
        ; Si c'est un defun
        ((eql (car expr) 'defun)
         (setf (get (second expr) :defun) 
               `( ,(+ 1 (length (third expr))) 
                  ,(second expr) . ,(map-lisp2li (cdddr expr) (make-stat-env (third expr) 1)))))
	;Implémentation du setf pour ne pas que la macro setf soit expandé
	((eql 'setf (car expr)) (setf2li expr env))
	; Si c'est une macro
        ((macro-function (car expr)) (lisp2li (macroexpand-1 expr) env))

        ; Fonction definie
        (t `(:call ,(car expr) . ,(map-lisp2li (cdr expr) env))))))

; Get-defun
(defun get-defun (symb)
  (get symb :defun))

;Traite le cas particulier du setf
(defun setf2li (expr env)
  ;Si on a une variable
  (if (symbolp (second expr))
         `(:set-var ,(second expr) . ,(lisp2li (third expr) env))
    `(:set-fun ,(lisp2li (second expr) env))))
